; =================================================
; transforms contents of the given s-exp to string
; =================================================


(defmacro def-trans-table (&rest args)
  )


(define-condition trans-error (error)
  ((origin :initarg :origin :initform nil :reader origin))
  (:report (lambda (condition stream)
             (format stream "trans error at ~a~%" (origin condition))))
  (:documentation "Transform error base class."))

;(define-condition trans-func-error (trans-error))

(defun mp-seq (context c-type c-arg)
  (format t "stat: ~a, ~a, ~a~%" context c-type c-arg))

(defmacro def-u (&rest func)
  )

(def-u
    (func (name-and-type args body)
          (seq 'type (car name-and-type))
          (seq 'func-name (cadr name-and-type))
          (seq 'func-args args)
          (seq 'block body))
    )

(def-u
    (func (:symbol name) (:cons arglist) (:rest body)))

(defmacro boo (&rest args)
  `(quote ,args))

; =================================================
; macro replacer that replaces functional occurences (i.e. when it is the first one)
; of the rep-item in the source list by the contents of the rep-list
(defmacro functional-replace (src-list rep-item rep-list)
  (let ((replacer-lambda (lambda (src-list replacement-item replacement-list)
	  (let ((first (car src-list)))
	    (if (eq first replacement-item) ; replace first item if it matches replacement-item
		(setf first replacement-list)
		(setf first (list first)))
	    (append first (loop for arg in (cdr src-list) ; propagate changes
			     collect
			       (if (listp arg)
				   (replace-func-transform
				    arg replacement-item replacement-list)
				   arg)))))))
    `(,@(funcall replacer-lambda src-list rep-item rep-list))))

; =================================================
; replaces occurences of the replacement item in the
; source list by the contents of replacement-list
; replacement item candidate shall always be the first element
; Example:
;           (replace-func-transform '(seq 1 2 3 (seq 4 5)) 'seq '(onyx one))
; gives ->  (onyx one 1 2 3 (onyx one 4 5))
(defun replace-func-transform (src-list replacement-item replacement-list)
  (let ((first (car src-list)))
    ; replace first item if needed
    (if (eq first replacement-item)
	(setf first replacement-list)
	(setf first (list first)))
    ; propagate changes to the rest of the list
    (append first (loop for arg in (cdr src-list) collect
		       (if (listp arg)
			   (replace-func-transform
			    arg replacement-item replacement-list)
			   arg)))))

; =================================================
; provides lambda expansion of the arguments given
(defmacro create-lambda-map-from-list (mapping-list)
  (let ((result-map (gensym "result-map-")))
    `(let ((,result-map (make-hash-table)))
       ,@(loop for mapping-iterator in mapping-list
	      collect `(setf (gethash ',(car mapping-iterator) ,result-map)
			     (lambda ,@(cdr mapping-iterator))))
       ,result-map)))


; =================================================
; provides lambda expansion of the arguments given
(defmacro create-lambda-map (&rest mapping-list)
  `(create-lambda-map-from-list ,mapping-list))


(defmacro create-lambda-list-2 (arg) `(create-lambda-list ,@arg))

; =================================================
; creates lambda map with the functional replace applied
(defmacro create-ftl-map (rep-item rep-context rep-function &rest mapping-list)
  `(create-lambda-map
    ,@(frep mapping-list rep-item (rep-function rep-context))))
;  (let ((v (create-lambda-list-2 mapping-list)))
;  (let ((v (list 1 2 3)))
;    `(,@(functional-replace v rep-item (rep-function rep-context)))))

; =================================================
; provides expanded version of the lambda map
(defmacro create-lambda-map-transformed-1 (rep-item rep-context rep-function &rest mapping-list)
  `(replace-func-transform '(create-lambda-map ,@mapping-list) ',rep-item '(,rep-function ,rep-context)))

(defmacro frep (src-list rep-item rep-subst)
  `(macrolet ((,rep-item (&rest args) (append ',rep-subst args)))
     ,src-list))

(defmacro create-lambda-map-transformed-2 (rep-item rep-context rep-function &rest mapping-list)
  `(create-lambda-map ,@(replace-func-transform mapping-list rep-item '(rep-function))))
;  (let ((u `(create-lambda-map ,@mapping-list)))
;  `(let (v)
;     (setf v ,u)
;     v)))
